Supercompiler 1997/SUPERCOMPILER97.iso/Delphi 3.0/DATA.Z/htcoledt.pas

Pascal/Delphi Source File | 1997-01-29 | 9.6 KB | 353 lines

unit HTColEdt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Colnedit, Menus, StdCtrls, ExtCtrls, OleCtrls, ISP3, DBWeb, DsgnIntf,
  DB, TypInfo, ComCtrls;

const
  HTMLColors: array[0..15] of string =
    ('Aqua', 'Black', 'Blue', 'Fushsia', 'Gray', 'Green', 'Lime', 'Maroon',
     'Navy', 'Olive', 'Purple', 'Red', 'Silver', 'Teal', 'White', 'Yellow');
  CM_POSTCHANGE = WM_USER + $200;

type
  THTMLTableEditor = class(TCollectionEditor)
    HTML: THTML;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    TableBorderEdit: TEdit;
    CellPaddingEdit: TEdit;
    CellSpacingEdit: TEdit;
    TableWidthEdit: TEdit;
    TableAlignCombo: TComboBox;
    TableBgColorCombo: TComboBox;
    AddAllFields: TButton;
    Addallfields1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure HTMLDoRequestDoc(Sender: TObject; const URL: WideString;
      const Element: HTMLElement; const DocInput: DocInput;
      var EnableDefault: WordBool);
    procedure TableDataChanged(Sender: TObject);
    procedure TableDataKeyPress(Sender: TObject; var Key: Char);
    procedure TableDataExit(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TableDataClicked(Sender: TObject);
    procedure AddAllFieldsClick(Sender: TObject);
  private
    FHTTPDSHandlerEditor: TDSTableProducerEditor;
    FModified: Boolean;
    procedure CMPostChange(var M: TMessage); message CM_POSTCHANGE;
    procedure PostChange;
    procedure UpdateTableAttributes;
    procedure UpdateTableComponent;
  public
    procedure Activated; override;
    procedure FormModified; override;
    procedure UpdateHTMLView;
    function GetDataSet: TDataSet;
    procedure SetAddAllFieldsState;
  end;

  THTMLDSTableProducerEditor = class(TDSTableProducerEditor)
  private
    FHTMLTableEditor: THTMLTableEditor;
  public
    constructor Create(HTMLTableEditor: THTMLTableEditor;
      DSTableProducer: TDSTableProducer);
    destructor Destroy; override;
    procedure Changed; override;
    procedure PostChange; override;
    property HTMLTableEditor: THTMLTableEditor read FHTMLTableEditor;
  end;

procedure ShowHTMLTableEditor(ADesigner: TDesigner;
  DSTableProducer: TDSTableProducer; const PropertyName: string);

implementation

uses HTTPApp, WebConst, NetConst;

{$R *.DFM}

procedure ShowHTMLTableEditor(ADesigner: TDesigner;
  DSTableProducer: TDSTableProducer; const PropertyName: string);
var
  Editor: THTMLDSTableProducerEditor;
  HTMLTableEditor: THTMLTableEditor;
begin
  if DSTableProducer.Editor <> nil then
  begin
    Editor := THTMLDSTableProducerEditor(DSTableProducer.Editor);
    HTMLTableEditor := Editor.HTMLTableEditor;
    HTMLTableEditor.Show;
  end else
  begin
    HTMLTableEditor := THTMLTableEditor(ShowCollectionEditorClass(ADesigner,
      THTMLTableEditor, DSTableProducer, DSTableProducer.Columns, PropertyName));
    THTMLDSTableProducerEditor.Create(HTMLTableEditor, DSTableProducer);
  end;
end;

{ THTMLDSTableProducerEditor }

constructor THTMLDSTableProducerEditor.Create(HTMLTableEditor: THTMLTableEditor;
  DSTableProducer: TDSTableProducer);
begin
  inherited Create(DSTableProducer);
  FHTMLTableEditor := HTMLTableEditor;
  FHTMLTableEditor.FHTTPDSHandlerEditor := Self;
end;

destructor THTMLDSTableProducerEditor.Destroy;
begin
  if FHTMLTableEditor <> nil then
    FHTMLTableEditor.Free;
  inherited Destroy;
end;

procedure THTMLDSTableProducerEditor.Changed;
begin
  if FHTMLTableEditor.StateLock = 0 then
  begin
    FHTMLTableEditor.UpdateListBox;
    FHTMLTableEditor.UpdateHTMLView;
    FHTMLTableEditor.UpdateTableAttributes;
  end;
end;

procedure THTMLDSTableProducerEditor.PostChange;
begin
  if FHTMLTableEditor.StateLock = 0 then
    FHTMLTableEditor.PostChange;
end;

{ THTMLTableEditor }

procedure THTMLTableEditor.Activated;
begin
  if StateLock = 0 then
  begin
    inherited;
    UpdateHTMLView;
    UpdateTableAttributes
  end;
end;

procedure THTMLTableEditor.AddAllFieldsClick(Sender: TObject);
var
  Result, I: Integer;
  DataSet: TDataSet;
begin
  Result := idYes;
  if (Collection.Count > 0) and
    ((Collection as THTMLTableColumns).State = csCustom) then
    Result := MessageDlg(sDeleteColumnsQuestion, mtConfirmation, mbYesNoCancel, 0);

  LockState;
  try
    case Result of
      idCancel: Exit;
      idYes: (Collection as THTMLTableColumns).RebuildColumns;
      idNo:
        begin
          DataSet := GetDataSet;
          if DataSet <> nil then
            with Dataset do
            begin
              Collection.BeginUpdate;
              try
                for I := 0 to FieldCount-1 do
                  THTMLTableColumns(Collection).Add.FieldName := Fields[I].FieldName;
              finally
                Collection.EndUpdate;
              end;
              for I := 0 to Collection.Count - 1 do
                THTMLTableColumns(Collection).Items[I].Update;
            end;
        end;
    end;
  finally
    UnlockState;
    SetSelection;
    Designer.Modified;
  end;
end;

procedure THTMLTableEditor.CMPostChange(var M: TMessage);
begin
  inherited;
  UpdateListBox;
  UpdateTableAttributes;
  UpdateHTMLView;
end;

procedure THTMLTableEditor.FormModified;
begin
  // DSTableProducerEditor will handle all updates
  inherited FormModified;
  SetAddAllFieldsState;
end;

procedure THTMLTableEditor.UpdateHTMLView;
begin
  with Component as TDSTableProducer do
    if (DataSet <> nil) and (StateLock = 0)  then
      Self.HTML.RequestDoc('file://foobar');
end;

procedure THTMLTableEditor.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  inherited;
  for I := Ord(Low(THTMLAlign)) to Ord(High(THTMLALign)) do
    TableAlignCombo.Items.Add(GetEnumName(TypeInfo(THTMLAlign), I));
  for I := Low(HTMLColors) to High(HTMLColors) do
    TableBgColorCombo.Items.Add(HTMLColors[I]);
end;

procedure THTMLTableEditor.FormDestroy(Sender: TObject);
begin
  inherited;
  if (FHTTPDSHandlerEditor <> nil) then
    with THTMLDSTableProducerEditor(FHTTPDSHandlerEditor) do
    begin
      FHTMLTableEditor := nil;
      Free;
    end;
end;

function THTMLTableEditor.GetDataSet: TDataSet;
begin
  if (Component <> nil) and (Component is TDSTableProducer) then
    Result := TDSTableProducer(Component).DataSet
  else Result := nil;
end;

procedure THTMLTableEditor.HTMLDoRequestDoc(Sender: TObject;
  const URL: WideString; const Element: HTMLElement;
  const DocInput: DocInput; var EnableDefault: WordBool);
begin
  inherited;
  with Component as TDSTableProducer do
  begin
    LockState;
    try
      BeginUpdate;
      try
        if DataSet.Active then DataSet.First;
        DocInput.SetData(WideString(
          Header.Text +
          HTMLTable(DataSet, TDSTableProducer(Component), MaxRows) +
          Footer.Text));
      finally
        EndUpdate;
      end;
    finally
      UnlockState;
    end;
  end;
end;

procedure THTMLTableEditor.PostChange;
var
  M: TMsg;
begin
  if not PeekMessage(M, Handle, CM_POSTCHANGE, CM_POSTCHANGE, PM_NOREMOVE) then
    PostMessage(Handle, CM_POSTCHANGE, 0, 0);
end;

procedure THTMLTableEditor.SetAddAllFieldsState;
var
  DataSet: TDataSet;
begin
  DataSet := GetDataSet;
  AddAllFields.Enabled := (Dataset <> nil) and (Dataset.FieldCount > 0);
  AddAllFields1.Enabled := AddAllFields.Enabled;
end;

procedure THTMLTableEditor.TableDataChanged(Sender: TObject);
begin
  inherited;
  FModified := True;
end;

procedure THTMLTableEditor.TableDataClicked(Sender: TObject);
begin
  inherited;
  UpdateTableComponent;
end;

procedure THTMLTableEditor.TableDataKeyPress(Sender: TObject;
  var Key: Char);
begin
  inherited;
  if FModified and (Key in [#13, #27]) then
  try
    if Key = #13 then
    begin
      UpdateTableComponent;
      if Sender is TEdit then
        TEdit(Sender).SelectAll
      else if Sender is TComboBox then
        if TComboBox(Sender).Style = csDropDown then
          TComboBox(Sender).SelectAll;
    end else if Key = #27 then
      UpdateTableAttributes;
  finally
    FModified := False;
    Key := #0;
  end else FormKeyPress(Sender, Key);
end;

procedure THTMLTableEditor.TableDataExit(Sender: TObject);
begin
  inherited;
  if FModified then
  try
    UpdateTableComponent;
  finally
    FModified := False;
  end;
end;

procedure THTMLTableEditor.UpdateTableAttributes;
begin
  with (Component as TDSTableProducer).TableAttributes do
  begin
    TableAlignCombo.ItemIndex := Ord(Align);
    TableBgColorCombo.Text := BgColor;
    TableBorderEdit.Text := IntToStr(Border);
    TableWidthEdit.Text := IntToStr(Width);
    CellPaddingEdit.Text := IntToStr(CellPadding);
    CellSpacingEdit.Text := IntToStr(CellSpacing);
  end;
end;

procedure THTMLTableEditor.UpdateTableComponent;
begin
  with Component as TDSTableProducer do
  begin
    BeginUpdate;
    try
      if (TableAlignCombo.ItemIndex >= Ord(Low(THTMLAlign))) and
        (TableAlignCombo.ItemIndex <= Ord(High(THTMLAlign))) then
        TableAttributes.Align := THTMLAlign(TableAlignCombo.ItemIndex);
      TableAttributes.Border := StrToIntDef(TableBorderEdit.Text, -1);
      TableAttributes.BgColor := TableBgColorCombo.Text;
      TableAttributes.CellPadding := StrToIntDef(CellPaddingEdit.Text, -1);
      TableAttributes.CellSpacing := StrToIntDef(CellSpacingEdit.Text, -1);
      TableAttributes.Width := StrToIntDef(TableWidthEdit.Text, 100);
    finally
      FModified := False;
      EndUpdate;
    end;
  end;
end;

end.